#!/usr/bin/perl -w
#
# $Id$
#
# Copyright (c) 2003,2004,2005 Roy Arends & Jakob Schlyter.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. The name of the authors may not be used to endorse or promote products
#    derived from this software without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

require 5.6.0;

use strict;
use warnings;

use Net::DNS 0.42;
use Net::DNS::Fingerprint;

use Getopt::Std;
use vars qw/ %opt /;
use POSIX ":sys_wait_h";

my $progname = "fpdns";
my $version = Net::DNS::Fingerprint->version();

sub main
{
    $opt{p} = 53;
    $opt{t} = 5;
    $opt{r} = 1;
    $opt{F} = 10;
    $opt{T} = 0;
    $opt{Q} = undef;
    $opt{S} = " ";

    my %children;

    my $concurrent = 0;

    getopts('Q:DF:p:t:r:cfsS:dTv', \%opt);

    $opt{v} && die "$progname version $version\n";
    
    unless ($#ARGV >= 0) {
        usage(); 
        exit(1);
    }

    my $engine = Net::DNS::Fingerprint->new(
	source   => $opt{Q},
	debug    => $opt{d},
	timeout  => $opt{t},
	retry    => $opt{r},
        forcetcp => $opt{T},
	qversion => $opt{v},
	qchaos   => $opt{f},
	separator=> $opt{S},
    );

    if ($ARGV[0] eq "-") {
       while(<STDIN>) {
          my $pid = fork;
          if ((not defined $pid) and not ($! =~ /Resource temporarily unavailable/)) {
             die "Can't fork: $!\n";
          } elsif ($pid == 0) {
             chomp;
             fingerprint($engine, $_);
             exit(0);
          } else {
             $concurrent++;
             $children{$pid} = 1;
             while ($concurrent >= $opt{F}) {
                my $child = waitpid -1, 0;
                $concurrent--;
                delete($children{$child});
             }
          }
       }
       while ($concurrent) {
          my $child = waitpid -1, 0;
          $concurrent--;
          delete($children{$child});
       }
    } else {
        while($#ARGV + 1) {
            fingerprint($engine, shift @ARGV);
        }
    }
}

sub fingerprint
{
    my ($engine,$server) = @_;
    my @addresses = dnslookup($server);
    if ($#addresses >= 0) {
	for my $a (@addresses) {
	    my $fp = $engine->string($a, $opt{p});
	    $opt{s} && (printf("%-15s %s\n", $a, $fp)) || print "fingerprint ($server, $a): $fp\n";
	}
    } else {
	print STDERR "host not found ($server)";
    }
}

sub dnslookup
{
    my $arg = shift;
    my @addresses = ();
    return $arg if ($arg =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/);

    my $resolver = Net::DNS::Resolver->new(srcaddr=>$opt{Q},usevc=>$opt{T});
    if ($opt{D}) {
       my $query = $resolver->send($arg, "NS");
       if ($query) {
          for my $rr ($query->answer) {
             my $query_address = $resolver->send($rr->rdatastr, "A") if $rr->type eq "NS";
             if ($query_address) {
                for my $address_rr ($query_address->answer) {
                   push @addresses, $address_rr->address if $address_rr->type eq "A";
                }
             }
          }
       }
    } else { 
       my $query = $resolver->send($arg, "A");
       if ($query) {
     	  for my $rr ($query->answer) {
	     push @addresses, $rr->address if $rr->type eq "A";
	  }
       }
    }

    return @addresses;
}

sub usage
{
    print STDERR <<EOF;
Usage: $progname [-c] [-d] [-D] [-f] [-p port] [-Q srcaddr] [-r retry] [-s] [-t timeout] [-T] [-v] server(s)|Domain
Where: server|Domain is an ip address, a resolvable name, or a domain name.
       or '-' to read list of servers from stdin
       -c         (where appropriate check CH TXT version) [off]
       -d         (debug) [off]
       -D         (check all authoritative servers for Domain)
       -f         (force check CH TXT version) [off]
       -F nchild  (maximum forked processes) [10]
       -p port    (nameserver is on this port) [53]
       -Q srcaddr (source IP address) [0.0.0.0]
       -r retry   (set number of attempts) [1]
       -s	  (short form) [off]
       -S	  (separator) [" "]
       -t time    (set query timeout) [5]
       -T         (use TCP) [off]
       -v         (show version)

EOF
        exit 2;

}

&main;


=head1 NAME

fpdns - DNS server fingeprinting tool

=head1 SYNOPSIS

B<fpdns> S<[ B<-c> ]> S<[ B<-d> ]> S<[ B<-f> ]> S<[ B<-F> I<nchild> ]>
   S<[ B<-p> I<port> ]> S<[ B<-Q> I<srcaddr> ]> S<[ B<-r> I<retry> ]>
   S<[ B<-s> ]>  S<[ B<-S> I<separator> ]> S<[ B<-t> I<timeout> ]> S<[ B<-v> ]> [I<server(s)>]

=head1 DESCRIPTION

B<fpdns> is a program that remotely determines DNS server versions.
It does this by sending a series of borderline DNS queries which are
compared against a table of responses and server versions. 

False positives or incorrect versions may be reported when 
trying to identify a set of servers residing behind a 
load-balancing apparatus where the servers are of different 
implementations, when a specific implementation behaves like a 
forwarder, behind a firewall without statefull inspection or without 
I<Application Intelligence>.  

=head1 OPTIONS

=over 5

=item B<-c>

Where appropriate check CH TXT version. Off by default. 

=item B<-d>

Enable debugging. Off by default. 

=item B<-D>

Check all authoritative servers of the specified domain name.

=item B<-f>

Force checking of CH TXT version. Off by default. 

=item B<-F> I<nchild>

Maximum number of forked child processes. Defaults to 10. 

=item B<-p> I<port>

Port to query remote nameserver on. Default is 53. 

=item B<-Q> I<srcaddr>

Set the source IP address to use. 

=item B<-r> I<retry>

Number of attempt to retry fingerprints. Defaults to 1. 

=item B<-s>

Short display form. Useful for surveys. 

=item B<-S>

Separator. Defaults to " ".

=item B<-t> I<timeout>

Set the query timeout in seconds. Defaults to 5. 

=item B<-T> 
                                                                                                                                      
Use TCP instead of UDP. 

=item B<-v>

Show version of fpdns. 

=item I<server>

IP address or name to query. Alternatively may be '-' to 
read from a list of these from stdin 

=back

=head1 AUTHORS

fpdns was written by Roy Arends and Jakob Schlyter.

=head1 SEE ALSO

L<perl(1)>, L<Net::DNS(1)>

=cut
